home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Just Call Me Internet
/
Just Call Me Internet.iso
/
com
/
computer
/
casio_st
/
prog_fx
/
divers
/
ephemeri.sha
< prev
next >
Wrap
Text File
|
1994-03-01
|
4KB
|
104 lines
10 CLEAR
20 DIM Z$(6),LO(7),LP(7),PO(7),PP(7),OO(7),OP(7),E(7),I(7),A(7):MODE 5
30 PRINT "EPHEMERIDES";CHR$(13);:INPUT "DATE(JJ.MM.AAAA)";J$:J=VAL(MID$(J$,1,2)):M=VAL(MID$(J$,4,2)):A=VAL(MID$(J$,7,4))
40 INPUT "HEURE TU (HH.MM.SS)";H$:H=VAL(MID$(H$,1,2)):T=VAL(MID$(H$,3,2)):S=VAL(MID$(H$,5,2))
50 HS=H/24+T/1440+S/86400:J=J+HS
60 N=A*365+31*(M-1)+J:IF M>2 GOTO 80
70 A=A-1
80 N=N+INT(A/4)-INT(A/100)+INT(A/400)
90 IF M<=2 GOTO 110
100 N=N-INT((M-1)*.4+2.7)
110 N=N-694325
120 PRINT "N="N;CSR(15);
130 DATA LUNDI,MARDI,MERCREDI,JEUDI,VENDREDI,SAMEDI,DIMANCHE
140 FOR I=0 TO 6:READ Z$(I):NEXT
150 I=INT((N/7-INT(N/7))*7+.005)
160 PRINT Z$(I)
170 DATA 4.8689,1.72027914E-2,4.9085,8.1856E-7,.01675104,1.00000023,3
180 READ LO,LP,PO,PP,E,A,KE
190 P=PO+PP*N:M=LO+LP*N-P
200 GOSUB 270
210 V=2*ATN(TAN(U/2)*SQR((1+E)/(1-E)))
220 R=A*(1-E*COS(U)):L=V+P
230 XS=R*COS(L):YS=R*SIN(L)
240 GOSUB 300
250 PRINT "LONG SOLEIL="DMS$(LD)
260 GOTO 340
270 Q=INT(M/2/PI):M=M-2*Q*PI:U=M
280 FOR K=0 TO KE
290 U=M+E*SIN(U):NEXT :RETURN
300 LD=L*180/PI
310 LD=(LD/360-INT(LD/360))*360
320 IF LD<0 THEN LD=LD+360
330 LD=INT(LD*10+.5)/10:RETURN
340 DATA 4.0117,7.14254534E-2,1.3249,7.4229E-7,.82304,5.6618E-7,.205615,.1222,.387098
350 DATA 3.6086,2.79631195E-2,2.2716,6.5572E-7,1.3229,4.366E-7,.006816,.05923,.7273
360 DATA 2.1776,9.14676584E-3,5.8338,8.793E-7,.8516,3.712E-7,.093309,3.2294E-2,1.523678
370 DATA 4.6879,1.4509868E-3,.2289,857E-9,1.7358,483E-9,.048376,.02284,5.202799
380 DATA 4.8567,5.8484028E-4,1.5974,412E-9,1.9686,417E-9,.054311,435E-4,9.552098
390 DATA 4.3224,205424E-9,2.9523,762E-9,1.2825,2.3824E-7,.047319,1.3482E-2,19.21694
400 DATA 1.5223,105061E-9,.7637,393E-9,2.281,525E-9,.008262,3.1054E-2,30.112912
410 DATA 1.6406,701214E-10,3.8978,6.672E-7,1.9034,6.672E-7,.250236,.29968,39.438712
420 FOR J=0 TO 7
430 READ LO(J),LP(J),PO(J),PP(J),OO(J),OP(J),E(J),I(J),A(J):NEXT
440 CLS:PRINT "ME,VE,MA,JU,SA,UR,NE,PL,TS,ST,EQ";:INPUT "PLANETE(.) :",P$
450 IF P$="." GOTO 1030
460 IF P$="ME" GOTO 580
470 IF P$="VE" GOTO 590
480 IF P$="MA" GOTO 600
490 IF P$="JU" GOTO 610
500 IF P$="SA" GOTO 620
510 IF P$="UR" GOTO 630
520 IF P$="NE" GOTO 640
530 IF P$="PL" GOTO 650
540 IF P$="TS" GOTO 820
550 IF P$="ST" THEN END
560 IF P$="EQ" GOTO 920
570 GOTO 440
580 T$="MERCURE":J=0:KE=5:GOTO 660
590 T$="VENUS":J=1:KE=3:GOTO 660
600 T$="MARS":J=2:KE=5:GOTO 660
610 T$="JUPITER":J=3:KE=4:GOTO 660
620 T$="SATURNE":J=4:KE=4:GOTO 660
630 T$="URANUS":J=5:KE=4:GOTO 660
640 T$="NEPTUNE":J=6:KE=3:GOTO 660
650 T$="PLUTON":J=7:KE=7:GOTO 660
660 P=PO(J)+PP(J)*N:M=LO(J)+LP(J)*N-P
670 E=E(J):GOSUB 270
680 V=2*ATN(TAN(U/2)*SQR((1+E)/(1-E)))
690 O=OO(J)+OP(J)*N:C=V+P-O
700 IF COS(C)=0 THEN D=C:GOTO 730
710 D=ATN(TAN(C)*COS(I(J)))
720 IF COS(C)<0 THEN D=D+PI
730 LS=D+O
740 BS=ATN(SIN(D)*TAN(I(J)))
750 RS=A(J)*(1-E*COS(U))
760 XP=RS*COS(BS)*COS(LS)+XS:YP=RS*COS(BS)*SIN(LS)+YS:ZP=RS*SIN(BS)
770 R=SQR(XP^2+YP^2):B=ATN(ZP/R):L=ATN(YP/XP)
780 IF XP<0 THEN L=L+PI
790 GOSUB 300
800 PRINT "LONGITUDE "T$"="DMS$(LD);CHR$(13);:PRINT "LATITUDE="DMS$(INT(B*18000/PI+.5)/100)
810 GOTO 440
820 INPUT "LONG LIEU EN DEG DECIMAUX, (-) A L'EST DE GREENWICH:";LO
830 RD=1.7273+1.72027914E-2*N+HS*2*PI-LO*PI/180
840 GOSUB 870
850 PRINT "TEMPS SIDERAL="H"h"M"m"S"s"
860 GOTO 440
870 RD=(RD/2/PI-INT(RD/2/PI))*2*PI
880 H=INT(RD/PI*12)
890 M=INT((RD-H*PI/12)*720/PI)
900 S=INT((RD-H*PI/12-M*PI/720)*43200/PI)
910 RETURN
920 EP=.40927971
930 SD=COS(EP)*SIN(B)+SIN(EP)*COS(B)*SIN(L)
940 DE=ATN(SD/SQR(1-SD^2))
950 SR=COS(EP)*COS(B)*SIN(L)-SIN(EP)*SIN(B)
960 RD=ATN(SR/COS(B)/COS(L))
970 IF COS(L)*COS(B)<0 THEN RD=RD+PI
980 IF RD<0 THEN RD=RD+PI*2
990 GOSUB 870
1000 PRINT "ASCENS. DROITE="H"h"M"m"S"s";CHR$(13);
1010 PRINT "DECLINAISON="DMS$(INT(DE*18000/PI+.5)/100)
1020 GOTO 440
1030 CLS:PRINT "ME:MERCURE, VE:VENUS, MA:MARS, JU:JUPITER, SA:SATURNE":CLS:PRINT "UR:URANUS, NE:NEPTUNE, PL:PLUTON":CLS:PRINT "TS:TEMPS SIDERAL LOCAL, EQ:COORDONNEES EQUATORIALES":CLS:PRINT "ST:FIN DU PROGRAMME, .:MENU AIDE":GOTO 500